home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / misc / emu / Apex-src.lha / TERMA.XPL < prev    next >
Text File  |  2001-09-30  |  12KB  |  432 lines
  1. \TERMA.XPL    JUL-01-88    VERSION 1.0x5 (SEE MAIN)
  2. \TERMINAL SIMULATOR PROGRAM
  3. \BY LOREN BLANEY
  4.  
  5. \REVISION HISTORY:
  6. \OCT-08-87, ORIGINAL RELEASED TO DFM.
  7. \OCT-09-87, V1.0x1, ECHO IN SEND MODE, CTXT.
  8. \DEC-17-87, V1.0X2,
  9. \FEB-03-88, V1.0X3, CHANGED COMMANDS, WILL WRITE OUTPUT FILE IN HEX MODE.
  10. \JUN-03-88, V1.0X4, FIX BLOW UP CAUSED BY BUFFER OVERFLOW.
  11. \JUN-27-88, V1.0X5, MODIFIED FOR THE AMIGA.
  12.  
  13. \WARNING:
  14. \This program is not finished (are they ever?). There is no parity, and
  15. \ the HALFSEC has not been adjusted.
  16.  
  17. \This program is extremely slow when receiving and displaying data. 
  18. \Higher baud rates can be used if the display is turned off. Also there
  19. \ may be a problem with handshake - the XOFF is overwritten perhaps before
  20. \ it is through transimtting. (RED RYDER didn't work with the Apple version.)
  21.  
  22. \NOTES:
  23. \No  handler is required for the serial device. Only XON/XOFF handshake
  24. \ protocol is used here, thus only three of the RS-232 lines need to be
  25. \ connected (pins 2, 3, and 7).
  26.  
  27. code    REM= 2,        RESERVE= 3,    CHIN= 7,    CHOUT= 8,
  28.     CRLF= 9,    TEXT= 12,    OPENI= 13,    OPENO= 14,
  29.     CLOSE= 15,    CURSOR= 23,    PEEK_W= 113,    POKE_W= 114,
  30.     GETKEY= 125,    KEYHIT= 126;
  31.  
  32. def    BUFSIZE= 10000,        \BUFFER SIZE IN BYTES
  33.     HALFSEC= 5000;        \CONSTANT TO DELAY 1/2 SECOND (H/W DEPENDENT)
  34.  
  35. def    SERDATR= $DFF018,
  36.     SERDAT= $DFF030,
  37.     SERPER= $DFF032,
  38.     INTREQ= $DFF09C;
  39.  
  40. def    BEL= $07, CR= $0D, FF= $0C, XON= $11, XOFF= $13, EOF= $1A, SP= $20;
  41. def    DN= $0A, UP= $0B, CTRL_S= $13, CTRL_W= $17;    \UP AND DOWN ARROWS
  42. def    LT= $08, RT= $15, CTRL_A= $01, CTRL_Q= $11;    \LEFT AND RIGHT ARROWS
  43.  
  44. int    PARAMS,        \ARRAY OF PARAMETERS: BAUD RATE, ETC.
  45.     CHAR,        \CHARACTER
  46.     TIMER,        \TO CONTINUE COLLECTING DATA 1/2 SEC AFTER XOFF IS SENT
  47.     TIMING,        \FLAG: "TIMER" IS ACTIVE
  48.     COLLECT,    \FLAG: COLLECT DATA FOR OUTPUT FILE
  49.     GOTSOME,    \FLAG: SOME DATA HAS BEEN COLLECTED
  50.     HALFDUP,    \FLAG: HALF DUPLEX, DISPLAY CHARACTERS SENT OUT RS-232
  51.     DISPON,        \FLAG: DISPLAY RECEIVED CHARACTERS ON THE SCREEN
  52.     HEXON,        \FLAG: CONVERT RECEIVED CHARACTERS TO HEX FORMAT
  53.     STATUS,        \STATUS BYTE READ FROM STATUS REGISTER
  54.     BUFINX,        \INDEX INTO "BUFFER", USUALLY POINTS TO AN EMPTY LOCATION
  55.     STOPBITS,    \MASK TO "OR" IN DATA BITS
  56.     DATABITS,    \MASK TO RECEIVE ONLY THE SPECIFIED NUMBER OF DATA BITS
  57.     II;        \SCRATCH FOR MAIN
  58. addr    BUFFER,        \BUFFER FOR RECEIVING TEXT FILES
  59.     HEXDIGIT;    \ARRAY TO CONVERT BINARY TO ASCII HEX
  60.  
  61. \----------------------------------------------------------------------
  62.  
  63. proc    FATAL(STR);
  64. addr    STR;
  65. begin
  66. CURSOR(0, 23);
  67. CHOUT(0, BEL);
  68. TEXT(0, "
  69. FATAL ERROR - ");
  70. TEXT(0, STR);
  71. CRLF(0);
  72. exit;
  73. end;    \FATAL
  74.  
  75.  
  76.  
  77. proc    CTXT(X, Y, STR);    \MOVE CURSOR AND DISPLAY TEXT ON CRT
  78. int    X, Y;
  79. addr    STR;
  80. begin
  81. CURSOR(X, Y);
  82. TEXT(0, STR);
  83. end;    \CTXT
  84.  
  85.  
  86.  
  87. func    DOPARITY(BYTE);        \SET THE PARITY BIT ACCORDING TO PARAMS(1)
  88. int    BYTE;
  89. reg int    I, B, P;
  90. int    MASK1, MASK2, SIZE;
  91. begin
  92. if PARAMS(3) = 1 then return BYTE;    \RETURN IF NO PARITY
  93. MASK1:= [0, $80, $100];            \SIZE: 7, 8
  94. MASK2:= [0, $7F, $FF];            \SIZE: 7, 8
  95. B:= BYTE;
  96. P:= 0;
  97. SIZE:= PARAMS(1);            \1: 7 BITS, 2: 8 BITS
  98. for I:= 1, SIZE+6 do
  99.     begin
  100.     B:= B <<1;
  101.     P:= P |B;
  102.     end;
  103. if PARAMS(3)=2 \ODD PARITY\ then P:= not P;    \1: NONE, 2:ODD, 3: EVEN
  104. return (P & MASK1(SIZE)) ! (BYTE & MASK2(SIZE));
  105. end;    \DOPARITY
  106.  
  107. \----------------------------------------------------------------------
  108.  
  109. proc    BUFOUT(CH);        \OUTPUT "CH" TO BUFFER
  110. int    CH;
  111. begin
  112. BUFFER(BUFINX):= CH;
  113. BUFINX:= BUFINX +1;
  114. if BUFINX >= BUFSIZE -30 then        \10 = SAFETY MARGIN FOR XOFF RESPONSE
  115.     begin                \BUFFER IS FULL
  116.     if BUFINX >= BUFSIZE then FATAL("DID NOT STOP ON XOFF COMMAND");
  117.     POKE_W(SERDAT, XOFF !STOPBITS);    \SEND XOFF    (BUG??? - WAIT FOR READY)
  118.     TIMER:= HALFSEC;        \START TIMER
  119.     TIMING:= true;
  120.     end;
  121. end;    \BUFOUT
  122.  
  123. \----------------------------------------------------------------------
  124.  
  125. proc    DOEXIT;        \CLOSE ANY OUTPUT FILE AND EXIT PROGRAM
  126. int    I;
  127. begin
  128. if GOTSOME then
  129.     begin
  130.     for I:= 0, BUFINX-1 do CHOUT(3,BUFFER(I));
  131.     CLOSE(3);
  132.     end;
  133. CURSOR(0, 23);
  134. exit;
  135. end;    \DOEXIT
  136.  
  137. \----------------------------------------------------------------------
  138.  
  139. proc    SENDFILE;    \SEND THE INPUT FILE OUT THE SERIAL PORT
  140. int    CH,        \CHARACTER TO SEND
  141.     KEY,        \KEYSTROKE
  142.     CHREC,        \CHARACTER RECEIVED
  143.     STAT;        \STATUS BYTE
  144. begin
  145. OPENI(3);
  146. STAT:= 0;
  147. loop    begin
  148.     CH:= CHIN(3);
  149.     if CH = EOF then quit;
  150.  
  151.     if STAT & $4000 then        \CHAR HAS BEEN RECEIVED FROM SERIAL PORT
  152.         begin
  153.         CHREC:= PEEK_W(SERDATR) & DATABITS;
  154.         POKE_W(INTREQ, $0800);    \CLEAR REC. BUF. FULL STATUS
  155.         if CHREC = XOFF then
  156.             begin
  157.             loop    begin        \WAIT FOR XON
  158.                 if PEEK_W(SERDATR) & $4000 then
  159.                     \CLEAR REC. BUF. FULL STATUS
  160.                     [POKE_W(INTREQ, $0800);
  161.                     if (PEEK_W(SERDATR) &DATABITS) = XON
  162.                         then quit];
  163.                 if KEYHIT then
  164.                     begin
  165.                     KEY:= GETKEY;
  166.                     if KEY = $98 then DOEXIT;    \CTRL-X
  167.                     if KEY = $83 then exit;        \CTRL-C
  168.                     end;
  169.                 end;
  170.             POKE_W(INTREQ, $0800);    \CLEAR REC. BUF. FULL STATUS
  171.             end
  172.         else    [CHOUT(0, CHREC);    \DISPLAY ANY RECEIVED CHAR
  173.             POKE_W(INTREQ, $0800)];    \CLEAR REC. BUF. FULL STATUS
  174.         end;
  175.  
  176.     if KEYHIT then
  177.         begin
  178.         KEY:= GETKEY;
  179.         if KEY = $98 then DOEXIT;    \CTRL-X
  180.         if KEY = $83 then exit;        \CTRL-C
  181.         end;
  182.  
  183.     if HALFDUP then CHOUT(0, CH);        \SHOW CHAR THAT WAS SENT
  184.  
  185.     \WAIT FOR XMITTER DATA REG EMPTY:
  186.     repeat STAT:= PEEK_W(SERDATR) until STAT & $2000;
  187.     POKE_W(SERDAT, CH !STOPBITS);
  188.     end;
  189. end;    \SENDFILE
  190.  
  191. \----------------------------------------------------------------------
  192.  
  193. proc    SETUP;        \SET UP TERMINAL PARAMETERS
  194. int    ENTRY,        \PARAMETER ENTRY NUMBER
  195.     KEY,        \CHARACTER FROM KEYBOARD
  196.     BAUD, DATAB, STOPB, PARITY, DUPLEX, DISPLAY, HEX;    \ARRAYS
  197.  
  198.  
  199.     func    SEL(S, X, Y, A);    \RETURN A SELECTED PARAMETER
  200.     int    S,        \INITIAL SELECTION
  201.         X, Y,        \SCREEN COORDINATES
  202.         A;        \ARRAY OF SELECTIONS (TEXT STRINGS)
  203.     begin
  204.     loop    begin
  205.         CTXT(X, Y, A(S));    \DISPLAY SELECTION
  206.         CURSOR(X, Y);        \FOR NEATNESS
  207.         KEY:= CHIN(1);
  208.         if KEY=SP ! KEY=CR then S:= S +1 else quit;
  209.         if S > A(0) then S:= 1;
  210.         end;
  211.     CTXT(X, Y, A(S));        \OVERWRITE GARBAGE LEFT BY CHIN
  212.     return S;
  213.     end;    \SEL
  214.  
  215.  
  216. begin    \SETUP
  217. CHOUT(0, FF);
  218. TEXT(0,"               -- PARAMETER SET UP --
  219.  
  220.     Select parameters with arrow keys (or CTRL-W and CTRL-S).
  221.  
  222.     Select options with space bar (or RETURN key).
  223.  
  224.     Press CTRL-P to save selected options (APX>SAVE TERM).
  225.  
  226.  
  227.     Baud rate:                Duplex:
  228.     Data bits:                Display:
  229.     Stop bits:                Hex:
  230.     Parity:
  231.  
  232.  
  233.                 -- OTHER COMMANDS --
  234.  
  235.     CTRL-@ -    Enter or exit Parameter Set Up mode.
  236.     CTRL-R -    Start (or Resume) collecting data in output file.
  237.     CTRL-F -    Finish collecting data.
  238.     CTRL-Y -    Send input file.
  239.     CTRL-^^ -    Send next CTRL character regardless.
  240.     CTRL-X -    Save file and return to Apex.");
  241.  
  242.  
  243.  
  244.     \NUMBER OF SELECTIONS, STRINGS DESCRIBING SELECTIONS:
  245. BAUD:= [  14,    "  110", "  135", "  150", "  300", "  600", " 1200", " 1800",
  246.     " 2400", " 3600", " 4800", " 7200", " 9600", "19200", "38400"];
  247. DATAB:= [2, "7", "8"];
  248. STOPB:= [2, "1", "2"];
  249. \PARITY:= [3, "NONE", "ODD ", "EVEN"];
  250. PARITY:= [3, "NONE", "NONE", "NONE"];        \*** DEBUG ***
  251. DUPLEX:= [2, "FULL", "HALF"];
  252. DISPLAY:= [2, "ON ", "OFF"];
  253. HEX:= [2, "ON ", "OFF"];
  254.  
  255. CTXT(24, 9, BAUD(PARAMS(0)));            \DISPLAY CURRENT VALUES
  256. CTXT(24, 10, DATAB(PARAMS(1)));
  257. CTXT(24, 11, STOPB(PARAMS(2)));
  258. CTXT(24, 12, PARITY(PARAMS(3)));
  259. CTXT(64, 9, DUPLEX(PARAMS(4)));
  260. CTXT(64, 10, DISPLAY(PARAMS(5)));
  261. CTXT(64, 11, DISPLAY(PARAMS(6)));
  262.  
  263. ENTRY:= 0;
  264. loop    begin                    \GET NEW VALUES
  265.     case ENTRY of
  266.       0:    PARAMS(0):= SEL(PARAMS(0), 24, 9, BAUD);
  267.       1:    PARAMS(1):= SEL(PARAMS(1), 24, 10, DATAB);
  268.       2:    PARAMS(2):= SEL(PARAMS(2), 24, 11, STOPB);
  269.       3:    PARAMS(3):= SEL(PARAMS(3), 24, 12, PARITY);
  270.       4:    PARAMS(4):= SEL(PARAMS(4), 64, 9, DUPLEX);
  271.       5:    PARAMS(5):= SEL(PARAMS(5), 64, 10, DISPLAY);
  272.       6:    PARAMS(6):= SEL(PARAMS(6), 64, 11, HEX)
  273.     other;
  274.  
  275.     case KEY of
  276.       DN, CTRL_S:    ENTRY:= ENTRY +1;
  277.       UP, CTRL_W:    ENTRY:= ENTRY -1;
  278.             \This only works when there are 7 entries:
  279.       RT, CTRL_A:    ENTRY:= ENTRY + (if ENTRY >= 4 then -3 else 4);
  280.       LT, CTRL_Q:    ENTRY:= ENTRY + (if ENTRY >= 4 then -4 else 3);
  281.  
  282.       $00:        quit;            \CTRL-@ - BACK TO TERMINAL MODE
  283.       $18:        DOEXIT            \CTRL-X - EXIT BACK TO APEX
  284.     other CHOUT(0, BEL);            \BEEP ON ILLEGAL KEYS
  285.  
  286.     if ENTRY > 6 then ENTRY:= 0;        \WRAP AROUND
  287.     if ENTRY < 0 then ENTRY:= 6;
  288.     end;
  289. CHOUT(0, FF);                \CLEAR SCREEN WHEN GOING TO TERMINAL MODE
  290. end;    \SETUP
  291.  
  292. \----------------------------------------------------------------------
  293.  
  294. proc    INITIALIZE;    \INITIALIZE SERIAL REGISTERS AND PARAMETERS
  295. int    BAUD;
  296. begin
  297. BAUD:=    [0, 110, 135, 150, 300, 600, 1200, 1800,
  298.     2400, 3600, 4800, 7200, 9600, 19200, 38400];
  299. \N = 1E9 /(BAUD_RATE *279.4) -1 = 3579098 /BAUD_RATE -1
  300. POKE_W(SERPER, 3579098 /BAUD(PARAMS(0)) -1);    \(LONG IS OFF = 8 BIT BYTES)
  301.  
  302. STOPBITS:= $0100;                \1 STOP BIT
  303. if PARAMS(2) = 2 then STOPBITS:= $0300;        \2 STOP BITS
  304.  
  305. \ASSUME 8 DATA BITS PER BYTE
  306. DATABITS:= $FF;
  307. \IF 7 BITS PER BYTE THEN SHIFT STOP BITS LEFT ONE BIT
  308. if PARAMS(1) = 1 then
  309.     begin
  310.     STOPBITS:= STOPBITS >>1;
  311.     DATABITS:= $7F;
  312.     end;
  313. \PARITY IS ALWAYS NONE
  314. \PARITY: 1=NONE, 2=ODD, 3=EVEN
  315. \if PARAMS(3) # 1 then STOPBITS:= STOPBITS <<1;
  316.  
  317. POKE_W(INTREQ, $0800);        \CLEAR REC. BUF. FULL STATUS
  318.  
  319.  
  320. HALFDUP:= PARAMS(4) = 2;        \INIT OTHER PARAMETERS
  321. DISPON:= PARAMS(5) = 1;
  322. HEXON:= PARAMS(6) = 1;
  323. end;    \INITIALIZE
  324.  
  325. \----------------------------------------------------------------------
  326.  
  327. begin    \MAIN
  328. PARAMS:= [6, 2, 1, 1, 1, 1, 2];        \SET UP FOR INITIAL DEFAULTS:
  329. \ 1200 BAUD, 8 DATA, 1 STOP, NO PARITY, FULL DUPLEX, DISPLAY ON, HEX OFF
  330.  
  331. HEXDIGIT:= "0123456789ABCDEF";
  332. BUFFER:= RESERVE(BUFSIZE);
  333.  
  334. COLLECT:= false;
  335. GOTSOME:= false;
  336. TIMING:= false;
  337. INITIALIZE;
  338. TEXT(0, "-- TERMINAL SIMULATOR, V1.0x5 --
  339.  
  340. Press CTRL-@ to set up parameters.
  341.  
  342. ");
  343. loop    begin
  344.     if KEYHIT then        \A KEY WAS HIT
  345.         begin
  346.         CHAR:= GETKEY;
  347.         case CHAR of
  348.           $00:    [SETUP;   INITIALIZE];    \CTRL-@: SET UP PARAMETERS
  349.           $12:    begin
  350.             COLLECT:= true;        \CTRL-R: RESUME COLLECTING DATA
  351.             if not GOTSOME then    \FIRST CTRL-R
  352.                 begin
  353.                 GOTSOME:= true;    \ASSUME WE'LL GET SOMETHING
  354.                 OPENO(3);
  355.                 BUFINX:= 0;
  356.                 end;
  357.             end;
  358.           $06:    COLLECT:= false;    \CTRL-F: FINISH COLLECTING DATA
  359.           $19:    SENDFILE;        \CTRL-Y: SEND THE INPUT FILE
  360.           $1E:    begin            \CTRL-^: ALWAYS SEND NEXT CHAR
  361.             repeat until KEYHIT;    \WAIT FOR KEYHIT
  362.             CHAR:= GETKEY;
  363.             POKE_W(SERDAT, CHAR !STOPBITS);    \SHOULD BE READY
  364.             if HALFDUP then CHOUT(0, CHAR);
  365.             end;
  366.           $18:    DOEXIT;            \CTRL-X: SAVE FILE AND EXIT
  367.           $03:    exit            \CTRL-C: JUST EXIT
  368.         other    begin
  369.             POKE_W(SERDAT, CHAR !STOPBITS);    \SHOULD BE READY, SLOW HUMANS
  370.             if HALFDUP then CHOUT(0, CHAR);
  371.             end;
  372.         end;
  373.  
  374.     STATUS:= PEEK_W(SERDATR);
  375.     if STATUS & $4000 then            \CHAR RECEIVED FROM SERIAL PORT
  376.         begin
  377.         if STATUS & $8000 then CHOUT(0,^#);    \OVERRUN ERROR
  378.         CHAR:= PEEK_W(SERDATR) &DATABITS;
  379.         POKE_W(INTREQ, $0800);        \CLEAR REC. BUF. FULL STATUS
  380.  
  381.         if DISPON then
  382.             if HEXON then 
  383.                 begin
  384.                 CHOUT(0, HEXDIGIT(CHAR>>4));
  385.                 CHOUT(0, HEXDIGIT(CHAR&$0F));
  386.                 CHAR:= CHAR & $7F;
  387.                 if CHAR>=$20 & CHAR<=$7E then CHOUT(0, CHAR)
  388.                 else CHOUT(0, ^.);
  389.                 CHOUT(0, SP);
  390.                 end
  391.             else     CHOUT(0, CHAR);
  392.  
  393.         if COLLECT then
  394.             begin
  395.             if HEXON then 
  396.                 begin
  397.                 BUFOUT(HEXDIGIT(CHAR>>4));
  398.                 BUFOUT(HEXDIGIT(CHAR&$0F));
  399.                 CHAR:= CHAR & $7F;
  400.                 if CHAR>=$20 & CHAR<=$7E then BUFOUT(CHAR)
  401.                 else BUFOUT(^.);
  402.                 BUFOUT(SP);
  403.                 end
  404.             else    begin        \("BUFOUT" INLINED FOR SPEED)
  405.                 BUFFER(BUFINX):= CHAR;
  406.                 BUFINX:= BUFINX +1;
  407.                 if BUFINX >= BUFSIZE -30 then
  408.                     begin            \BUFFER IS FULL
  409.                     if BUFINX >= BUFSIZE then
  410.                         FATAL("DID NOT STOP ON XOFF COMMAND");
  411.                     POKE_W(SERDAT, XOFF !STOPBITS);
  412.                     TIMER:= HALFSEC;    \START TIMER
  413.                     TIMING:= true;
  414.                     end;
  415.                 end;
  416.             end;
  417.         end;
  418.  
  419.     if TIMING then
  420.         begin
  421.         TIMER:= TIMER -1;
  422.         if TIMER <= 0 then    \TIMED OUT (SENDER BETTER HAVE STOPPED
  423.             begin        \ BY NOW)
  424.             for II:= 0, BUFINX-1 do CHOUT(3, BUFFER(II));
  425.             BUFINX:= 0;
  426.             POKE_W(SERDAT, XON !STOPBITS);    \(SHOULD BE READY)
  427.             TIMING:= false;
  428.             end;
  429.         end;
  430.     end;    \LOOP
  431. end;    \MAIN
  432. FINX:= 0;